SetIC Subroutine

private subroutine SetIC(inifile)

set initial condition

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: inifile

Variables

Type Visibility Attributes Name Initial
type(PlantsCohort), public, POINTER :: cohort
type(grid_integer), public :: cohort_map
real(kind=float), public :: dbh
integer(kind=short), public :: i
type(IniList), public :: icDB
integer(kind=short), public :: ispecies
integer(kind=short), public :: j
integer(kind=short), public :: k
integer(kind=short), public :: l
integer(kind=short), public :: ncohorts

Source Code

SUBROUTINE  SetIC &
!
(inifile)

IMPLICIT NONE

CHARACTER (LEN = *), INTENT(in) :: inifile

!local declarations:
TYPE (IniList) :: icDB
INTEGER (KIND = short) :: ncohorts
TYPE (grid_integer) :: cohort_map
INTEGER (KIND = short) :: i, j, k, l
INTEGER (KIND = short) :: ispecies
REAL (KIND = float) :: dbh 
TYPE (PlantsCohort), POINTER :: cohort

!------------------------------end of declarations----------------------------

! open and read configuration file
CALL IniOpen (inifile, icDB)

!number of cohorts
ncohorts = IniReadInt ('cohorts', icDB)

!starting year
year_new = IniReadInt ('year', icDB)
year_prev = IniReadInt ('year', icDB)

!cohort map
CALL GridByIni (icDB, cohort_map, section = 'cohorts-map') 


DO k = 1, count_stands
    !aggiungere configurazione ricorsiva quando ci sono più coorti per cella
    !al momento solo una coorte per stand (cella)
    cohort => forest (k) % first
    DO l = 1, forest (k) % lenght
       ispecies = IniReadInt ('species', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % species = species (ispecies)
       cohort % age = IniReadInt ('age', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % density = IniReadReal ('density', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % height = IniReadReal ('height', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % dbh = IniReadReal ('dbh', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % lai = IniReadReal ('lai', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % mass_stem = IniReadReal ('stem-biomass', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % mass_root = IniReadReal ('root-biomass', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % mass_leaf = IniReadReal ('leaf-biomass', icDB, section = ToString   (cohort_map % mat (forest (k) % i, forest (k) % j )  ) )
       cohort % mass_total = cohort % mass_stem + cohort % mass_root + cohort % mass_leaf
       cohort % crown_diameter = CrownDiameter ( dbh = cohort % dbh, den = cohort % density, &
                                                 denmin = species (ispecies) % denmin, &
                                                 denmax = species (ispecies) % denmax, &
                                                 dbhdcmin = species (ispecies) % dbhdcmin, &
                                                 dbhdcmax = species (ispecies) % dbhdcmax ) 
       cohort % canopy_cover = CanopyCover (  cohort % crown_diameter, cohort % density )
       cohort => cohort % next
    END DO
END DO

! Deallocate memory
CALL IniClose (icDB)  
    
RETURN
END SUBROUTINE SetIC